home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / nnkiboze.el.z / nnkiboze.el
Encoding:
Text File  |  1998-05-21  |  12.4 KB  |  356 lines
  1. ;;; nnkiboze.el --- select virtual news access for Gnus
  2. ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;; Keywords: news
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; The other access methods (nntp, nnspool, etc) are general news
  27. ;; access methods.  This module relies on Gnus and can't be used
  28. ;; separately.
  29.  
  30. ;;; Code:
  31.  
  32. (require 'nntp)
  33. (require 'nnheader)
  34. (require 'gnus)
  35. (require 'gnus-score)
  36. (require 'nnoo)
  37. (eval-when-compile (require 'cl))
  38.  
  39. (nnoo-declare nnkiboze)
  40. (defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/")
  41.   "nnkiboze will put its files in this directory.")
  42.  
  43. (defvoo nnkiboze-level 9
  44.   "The maximum level to be searched for articles.")
  45.  
  46. (defvoo nnkiboze-remove-read-articles t
  47.   "If non-nil, nnkiboze will remove read articles from the kiboze group.")
  48.  
  49. (defvoo nnkiboze-ephemeral nil
  50.   "If non-nil, don't store any data anywhere.")
  51.  
  52. (defvoo nnkiboze-scores nil
  53.   "Score rules for generating the nnkiboze group.")
  54.  
  55. (defvoo nnkiboze-regexp nil
  56.   "Regexp for matching component groups.")
  57.  
  58.  
  59.  
  60. (defconst nnkiboze-version "nnkiboze 1.0")
  61.  
  62. (defvoo nnkiboze-current-group nil)
  63. (defvoo nnkiboze-status-string "")
  64.  
  65. (defvoo nnkiboze-headers nil)
  66.  
  67.  
  68.  
  69. ;;; Interface functions.
  70.  
  71. (nnoo-define-basics nnkiboze)
  72.  
  73. (deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
  74.   (nnkiboze-possibly-change-group group)
  75.   (unless gnus-nov-is-evil
  76.     (if (stringp (car articles))
  77.     'headers
  78.       (let ((nov (nnkiboze-nov-file-name)))
  79.     (when (file-exists-p nov)
  80.       (save-excursion
  81.         (set-buffer nntp-server-buffer)
  82.         (erase-buffer)
  83.         (nnheader-insert-file-contents nov)
  84.         (nnheader-nov-delete-outside-range
  85.          (car articles) (car (last articles)))
  86.         'nov))))))
  87.  
  88. (deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
  89.   (nnkiboze-possibly-change-group newsgroup)
  90.   (if (not (numberp article))
  91.       ;; This is a real kludge.  It might not work at times, but it
  92.       ;; does no harm I think.  The only alternative is to offer no
  93.       ;; article fetching by message-id at all.
  94.       (nntp-request-article article newsgroup gnus-nntp-server buffer)
  95.     (let* ((header (gnus-summary-article-header article))
  96.        (xref (mail-header-xref header)))
  97.       (unless xref
  98.     (error "nnkiboze: No xref"))
  99.       (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
  100.     (error "nnkiboze: Malformed xref"))
  101.       (gnus-request-article (string-to-int (match-string 2 xref))
  102.                 (match-string 1 xref)
  103.                 buffer))))
  104.  
  105. (deffoo nnkiboze-request-scan (&optional group server)
  106.   (nnkiboze-generate-group (concat "nnkiboze:" group)))
  107.  
  108. (deffoo nnkiboze-request-group (group &optional server dont-check)
  109.   "Make GROUP the current newsgroup."
  110.   (nnkiboze-possibly-change-group group)
  111.   (if dont-check
  112.       t
  113.     (let ((nov-file (nnkiboze-nov-file-name))
  114.       beg end total)
  115.       (save-excursion
  116.     (set-buffer nntp-server-buffer)
  117.     (erase-buffer)
  118.     (if (not (file-exists-p nov-file))
  119.         (nnheader-report 'nnkiboze "Can't select group %s" group)
  120.       (nnheader-insert-file-contents nov-file)
  121.       (if (zerop (buffer-size))
  122.           (nnheader-insert "211 0 0 0 %s\n" group)
  123.         (goto-char (point-min))
  124.         (when (looking-at "[0-9]+")
  125.           (setq beg (read (current-buffer))))
  126.         (goto-char (point-max))
  127.         (when (re-search-backward "^[0-9]" nil t)
  128.           (setq end (read (current-buffer))))
  129.         (setq total (count-lines (point-min) (point-max)))
  130.         (nnheader-insert "211 %d %d %d %s\n" total beg end group)))))))
  131.  
  132. (deffoo nnkiboze-close-group (group &optional server)
  133.   (nnkiboze-possibly-change-group group)
  134.   ;; Remove NOV lines of articles that are marked as read.
  135.   (when (and (file-exists-p (nnkiboze-nov-file-name))
  136.          nnkiboze-remove-read-articles)
  137.     (nnheader-temp-write (nnkiboze-nov-file-name)
  138.       (let ((cur (current-buffer)))
  139.     (nnheader-insert-file-contents (nnkiboze-nov-file-name))
  140.     (goto-char (point-min))
  141.     (while (not (eobp))
  142.       (if (not (gnus-article-read-p (read cur)))
  143.           (forward-line 1)
  144.         (gnus-delete-line))))))
  145.   (setq nnkiboze-current-group nil))
  146.  
  147. (deffoo nnkiboze-open-server (server &optional defs)
  148.   (unless (assq 'nnkiboze-regexp defs)
  149.     (push `(nnkiboze-regexp ,server)
  150.       defs))
  151.   (nnoo-change-server 'nnkiboze server defs))
  152.  
  153. (deffoo nnkiboze-request-delete-group (group &optional force server)
  154.   (nnkiboze-possibly-change-group group)
  155.   (when force
  156.      (let ((files (list (nnkiboze-nov-file-name)
  157.             (concat nnkiboze-directory
  158.                                 (nnheader-translate-file-chars
  159.                                  (concat group ".newsrc")))
  160.             (nnkiboze-score-file group))))
  161.        (while files
  162.      (and (file-exists-p (car files))
  163.           (file-writable-p (car files))
  164.           (delete-file (car files)))
  165.      (setq files (cdr files)))))
  166.   (setq nnkiboze-current-group nil))
  167.  
  168. (nnoo-define-skeleton nnkiboze)
  169.  
  170.  
  171. ;;; Internal functions.
  172.  
  173. (defun nnkiboze-possibly-change-group (group)
  174.   (setq nnkiboze-current-group group))
  175.  
  176. (defun nnkiboze-prefixed-name (group)
  177.   (gnus-group-prefixed-name group '(nnkiboze "")))
  178.  
  179. ;;;###autoload
  180. (defun nnkiboze-generate-groups ()
  181.   "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups
  182. Finds out what articles are to be part of the nnkiboze groups."
  183.   (interactive)
  184.   (let ((nnmail-spool-file nil)
  185.     (gnus-use-dribble-file nil)
  186.     (gnus-read-active-file t)
  187.     (gnus-expert-user t))
  188.     (gnus))
  189.   (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
  190.      (newsrc (cdr gnus-newsrc-alist))
  191.      gnus-newsrc-hashtb info)
  192.     (gnus-make-hashtable-from-newsrc-alist)
  193.     ;; We have copied all the newsrc alist info over to local copies
  194.     ;; so that we can mess all we want with these lists.
  195.     (while (setq info (pop newsrc))
  196.       (when (string-match "nnkiboze" (gnus-info-group info))
  197.     ;; For each kiboze group, we call this function to generate
  198.     ;; it.
  199.     (nnkiboze-generate-group (gnus-info-group info))))))
  200.  
  201. (defun nnkiboze-score-file (group)
  202.   (list (expand-file-name
  203.      (concat (file-name-as-directory gnus-kill-files-directory)
  204.          (nnheader-translate-file-chars
  205.           (concat (nnkiboze-prefixed-name nnkiboze-current-group)
  206.               "." gnus-score-file-suffix))))))
  207.  
  208. (defun nnkiboze-generate-group (group)
  209.   (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
  210.      (newsrc-file (concat nnkiboze-directory 
  211.                               (nnheader-translate-file-chars
  212.                                (concat group ".newsrc"))))
  213.      (nov-file (concat nnkiboze-directory
  214.                            (nnheader-translate-file-chars
  215.                             (concat group ".nov"))))
  216.      method nnkiboze-newsrc gname newsrc active
  217.      ginfo lowest glevel orig-info nov-buffer
  218.      ;; Bind various things to nil to make group entry faster.
  219.      (gnus-expert-user t)
  220.      (gnus-large-newsgroup nil)
  221.      (gnus-score-find-score-files-function 'nnkiboze-score-file)
  222.      (gnus-verbose (min gnus-verbose 3))
  223.       gnus-select-group-hook gnus-summary-prepare-hook
  224.      gnus-thread-sort-functions gnus-show-threads
  225.      gnus-visual gnus-suppress-duplicates)
  226.     (unless info
  227.       (error "No such group: %s" group))
  228.     ;; Load the kiboze newsrc file for this group.
  229.     (when (file-exists-p newsrc-file)
  230.       (load newsrc-file))
  231.     (nnheader-temp-write nov-file
  232.       (when (file-exists-p nov-file)
  233.     (insert-file-contents nov-file))
  234.       (setq nov-buffer (current-buffer))
  235.       ;; Go through the active hashtb and add new all groups that match the
  236.       ;; kiboze regexp.
  237.       (mapatoms
  238.        (lambda (group)
  239.      (and (string-match nnkiboze-regexp
  240.                 (setq gname (symbol-name group))) ; Match
  241.           (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
  242.           (numberp (car (symbol-value group))) ; It is active
  243.           (or (> nnkiboze-level 7)
  244.           (and (setq glevel (nth 1 (nth 2 (gnus-gethash
  245.                            gname gnus-newsrc-hashtb))))
  246.                (>= nnkiboze-level glevel)))
  247.           (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
  248.           (push (cons gname (1- (car (symbol-value group))))
  249.             nnkiboze-newsrc)))
  250.        gnus-active-hashtb)
  251.       ;; `newsrc' is set to the list of groups that possibly are
  252.       ;; component groups to this kiboze group.  This list has elements
  253.       ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
  254.       ;; number that has been kibozed in GROUP in this kiboze group.
  255.       (setq newsrc nnkiboze-newsrc)
  256.       (while newsrc
  257.     (if (not (setq active (gnus-gethash
  258.                    (caar newsrc) gnus-active-hashtb)))
  259.         ;; This group isn't active after all, so we remove it from
  260.         ;; the list of component groups.
  261.         (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
  262.       (setq lowest (cdar newsrc))
  263.       ;; Ok, we have a valid component group, so we jump to it.
  264.       (switch-to-buffer gnus-group-buffer)
  265.       (gnus-group-jump-to-group (caar newsrc))
  266.       (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
  267.       (setq ginfo (gnus-get-info (gnus-group-group-name))
  268.         orig-info (gnus-copy-sequence ginfo))
  269.       (unwind-protect
  270.           (progn
  271.         ;; We set all list of article marks to nil.  Since we operate
  272.         ;; on copies of the real lists, we can destroy anything we
  273.         ;; want here.
  274.         (when (nth 3 ginfo)
  275.           (setcar (nthcdr 3 ginfo) nil))
  276.         ;; We set the list of read articles to be what we expect for
  277.         ;; this kiboze group -- either nil or `(1 . LOWEST)'.
  278.         (when ginfo
  279.           (setcar (nthcdr 2 ginfo)
  280.               (and (not (= lowest 1)) (cons 1 lowest))))
  281.         (when (and (or (not ginfo)
  282.                    (> (length (gnus-list-of-unread-articles
  283.                        (car ginfo)))
  284.                   0))
  285.                (progn
  286.                  (gnus-group-select-group nil)
  287.                  (eq major-mode 'gnus-summary-mode)))
  288.           ;; We are now in the group where we want to be.
  289.           (setq method (gnus-find-method-for-group
  290.                 gnus-newsgroup-name))
  291.           (when (eq method gnus-select-method)
  292.             (setq method nil))
  293.           ;; We go through the list of scored articles.
  294.           (while gnus-newsgroup-scored
  295.             (when (> (caar gnus-newsgroup-scored) lowest)
  296.               ;; If it has a good score, then we enter this article
  297.               ;; into the kiboze group.
  298.               (nnkiboze-enter-nov
  299.                nov-buffer
  300.                (gnus-summary-article-header
  301.             (caar gnus-newsgroup-scored))
  302.                gnus-newsgroup-name))
  303.             (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
  304.           ;; That's it.  We exit this group.
  305.           (gnus-summary-exit-no-update)))
  306.         ;; Restore the proper info.
  307.         (when ginfo
  308.           (setcdr ginfo (cdr orig-info)))))
  309.     (setcdr (car newsrc) (car active))
  310.     (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
  311.     (setq newsrc (cdr newsrc))))
  312.     ;; We save the kiboze newsrc for this group.
  313.     (nnheader-temp-write newsrc-file
  314.       (insert "(setq nnkiboze-newsrc '")
  315.       (gnus-prin1 nnkiboze-newsrc)
  316.       (insert ")\n"))
  317.     t))
  318.  
  319. (defun nnkiboze-enter-nov (buffer header group)
  320.   (save-excursion
  321.     (set-buffer buffer)
  322.     (goto-char (point-max))
  323.     (let ((xref (mail-header-xref header))
  324.       (prefix (gnus-group-real-prefix group))
  325.       (oheader (copy-sequence header))
  326.       (first t)
  327.       article)
  328.       (if (zerop (forward-line -1))
  329.       (progn
  330.         (setq article (1+ (read (current-buffer))))
  331.         (forward-line 1))
  332.     (setq article 1))
  333.       (mail-header-set-number oheader article)
  334.       (nnheader-insert-nov oheader)
  335.       (search-backward "\t" nil t 2)
  336.       (if (re-search-forward " [^ ]+:[0-9]+" nil t)
  337.       (goto-char (match-beginning 0))
  338.     (forward-char 1))
  339.       ;; The first Xref has to be the group this article
  340.       ;; really came for - this is the article nnkiboze
  341.       ;; will request when it is asked for the article.
  342.       (insert group ":"
  343.           (int-to-string (mail-header-number header)) " ")
  344.       (while (re-search-forward " [^ ]+:[0-9]+" nil t)
  345.     (goto-char (1+ (match-beginning 0)))
  346.     (insert prefix)))))
  347.  
  348. (defun nnkiboze-nov-file-name ()
  349.   (concat (file-name-as-directory nnkiboze-directory)
  350.       (nnheader-translate-file-chars
  351.        (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))))
  352.  
  353. (provide 'nnkiboze)
  354.  
  355. ;;; nnkiboze.el ends here
  356.